home *** CD-ROM | disk | FTP | other *** search
/ CICA 1993 April / CICA MS Windows - April 1993.iso / unzipped / programr / tp / tpwmi2 / pcttest.pas < prev    next >
Pascal/Delphi Source File  |  1992-08-12  |  2KB  |  77 lines
  1. { Percent Tester - test program for the TPercentDlg object, declared in
  2.     "percent.pas". Have a ball.
  3.  
  4.     Steve Willer
  5. }
  6.  
  7.  
  8. program PctTest;
  9.  
  10. {$R Percent.res}
  11.  
  12. uses WinProcs,WinTypes,Strings,WObjects,Percent;
  13.  
  14. type
  15.     TPctTestApp = object(TApplication)
  16.         procedure InitMainWindow; virtual;
  17.     end;
  18.  
  19.     PPctTestWindow = ^TPctTestWindow;
  20.     TPctTestWindow = object(TPercentDlg)
  21.         TimerH:word;
  22.         TimerUp:boolean;
  23.         procedure SetupWindow; virtual;
  24.         procedure WMTimer(var Msg:TMessage); virtual wm_Timer;
  25.         procedure Cancel(var Msg:TMessage); virtual id_First+id_Cancel;
  26.         destructor Done; virtual;
  27.     end;
  28.  
  29. procedure TPctTestApp.InitMainWindow;
  30. begin
  31.     MainWindow := New(PPctTestWindow,Init(nil,'Percent_2',2,true));
  32. end;
  33.  
  34. procedure TPctTestWindow.SetupWindow;
  35. begin
  36.     TPercentDlg.SetupWindow;
  37.     TimerH:=SetTimer(HWindow,20,200,nil);
  38.     TimerUp:=true;
  39.     SetText('Percentage Test',0);
  40.     SetText('Displaying Percentages',1);
  41.     SetText(nil,3);
  42.     SetText(nil,4);
  43. end;
  44.  
  45. procedure TPctTestWindow.WMTimer(var Msg:TMessage);
  46. var PctStr:string;
  47.         PctText:array[0..50] of char;
  48. begin
  49.     if TimerUp then AddPctLevel(7,1) else DelPctLevel(7,1);
  50.     if TimerUp then AddPctLevel(7,2) else DelPctLevel(7,2);
  51.     if ((PctCurrent[1]=PctHigh[1]) or (PctCurrent[1]=PctLow[1])) then
  52.         TimerUp:=not TimerUp;
  53.     str(PctCurrent[1],PctStr);
  54.     PctStr:='Current percentage: '+PctStr;
  55.     StrPCopy(PctText,PctStr);
  56.     SetText(PctText,2);
  57. end;
  58.  
  59. procedure TPctTestWindow.Cancel(var Msg:TMessage);
  60. begin
  61.     CloseWindow;
  62. end;
  63.  
  64. destructor TPctTestWindow.Done;
  65. begin
  66.     KillTimer(HWindow,20);
  67.     TPercentDlg.Done;
  68. end;
  69.  
  70. var Pct:TPctTestApp;
  71.  
  72. begin
  73.     Pct.Init('PercentApp');
  74.     Pct.Run;
  75.     Pct.Done;
  76. end.
  77.